home *** CD-ROM | disk | FTP | other *** search
/ Disc to the Future 2 / Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin / MAC / SMALLTAL / FRACTALW / FRACTAL_.WOR next >
Text File  |  1990-10-27  |  8KB  |  301 lines
  1. "
  2.     FractalWorkspace class
  3.  
  4.     I developed this class to learn about Digitalk Smalltalk/V
  5.     and to implement Clifford A. Pickover's cyclic system as
  6.     described in Computers & Graphics, vol. 11, #2, pgs 217-226.
  7.  
  8.     This file is in Digitalk's fileOut format and can therefore
  9.     be filed in directly.  To run the graphics execute the following:
  10.         FractalWorkspace new open.
  11.  
  12.     Choose restart in the Fractals menu.
  13.  
  14.     The supplied settings do not produce very striking pictures; they 
  15.     correspond to fig. 1a in the above paper. To get more detail, the 
  16.     sampling rectangle can be made smaller.  Many other parameters can 
  17.     be varied. The menu item 'fillin' will start an iteration sequence
  18.     from the location of a mouseclick. 
  19.  
  20.     The key methods for controlling the graphics are:
  21.         1) iterTimes:at:        -- the controlling equation
  22.         2) reframe:             -- the initial parameter settings 
  23.         3) open                 -- window size, etc.
  24.  
  25.     This was developed on my Mac Plus at home and runs fine on it.
  26.     I've occasionally run it on a Mac IIx and have had no problems
  27.     there either. No surprises are expected since Digitalk Smalltalk 
  28.     takes care of porting the application. The extra computing power
  29.     of the IIx is almost necessary.
  30.  
  31.     There are all sorts of extensions I'd like to implement, 'actual'
  32.     fractals, refinements of the iteration methods, ...  I usually
  33.     don't have the time to do much work on this. I would welcome any
  34.     suggestions and/or contributions to the methods and classes.
  35.  
  36.     Jeff Green
  37.     CIS:71170,726
  38.  
  39. "
  40.  
  41. Object subclass: #FractalWorkspace
  42.   instanceVariableNames:
  43.     'rectangle pen center scaleFactor plotRect resolution iterationTimes magnification menu menuItem '
  44.   classVariableNames: ''
  45.   poolDictionaries:
  46.     'FunctionKeys ' !
  47.  
  48. !FractalWorkspace class methods ! !
  49.  
  50.  
  51. !FractalWorkspace methods !
  52.  
  53. click: aPoint
  54.     "If fillin, start an iteration from click point."
  55.     | point scale orig pointGlobal |
  56.  
  57.      (menuItem = 'fillin') & EventRecord mouseDown ifTrue: [
  58.         EventRecord waitForMouseUp.
  59.         pointGlobal := EventRecord mousePointGlobal.
  60.         point := EventRecord mousePoint.
  61.         EventRecord getNextEvent.
  62.         (Scheduler activeWindow screenRect containsPoint: pointGlobal) ifFalse:
  63.            [^ self ].
  64.         scale := magnification * scaleFactor.
  65.         orig := center - (plotRect origin + (plotRect extent / 2) * scale).
  66.         point := (point - orig)/scale.
  67.         CursorManager normal.
  68.         menu enable: #stop.
  69.         self iterTimes:iterationTimes at: point.
  70.        ].!
  71.  
  72. cyclicSys
  73.     "Generate plots which iterate based on the
  74.         ╞x = -h*f(y), ╞y = h*f(x) system of equations.
  75.      "
  76.     | label |
  77.  
  78.     label :=    'from: ',
  79.                 plotRect origin printString,
  80.                 ',  to: ',
  81.                 plotRect corner printString,
  82.                 ',  iters=',
  83.                 iterationTimes printString,
  84.                 ',  res.=',
  85.                 resolution printString,
  86.                 ',  mag.=',
  87.                 self magnification printString.
  88.     Scheduler topDispatcher pane
  89.         label: label;
  90.         displayLabel.
  91.     Display white: rectangle.
  92.     menu disable: #restart.
  93.     menu disable: #fillin.
  94.     menu enable: #stop.
  95.     plotRect left to: plotRect right
  96.      by: (plotRect right - plotRect left)/resolution
  97.      do: [ :x |
  98.         plotRect bottom to: plotRect top
  99.          by: (plotRect top - plotRect bottom)/resolution
  100.          do: [ :y |
  101.             self iterTimes: iterationTimes at: x@y.
  102.             menuItem = 'stop'
  103.                 ifTrue: [
  104.                     ^self
  105.                  ].
  106.         ]
  107.     ].
  108.     menu enable: #restart.
  109.     menu enable: #fillin.
  110.     menu disable: #stop.!
  111.  
  112. fillin
  113.         "select start points"
  114.  
  115.     menu disable: #fillin.
  116.     CursorManager hair.
  117.     menuItem := 'fillin'.!
  118.  
  119. stop
  120.         "stop drawing"
  121.  
  122.     menu enable: #restart.
  123.     menu enable: #fillin.
  124.     menu disable: #stop.
  125.     menuItem := 'stop'.!
  126.  
  127. form: aRectangle
  128.     "Make a form for the demo window and return it."
  129.  
  130.    ^ Form new
  131.         width: aRectangle width height: aRectangle height!
  132.  
  133. from: oPoint to: cPoint
  134.         "sets phase space boundaries."
  135.  
  136.     plotRect isNil
  137.         ifTrue: [ plotRect := Rectangle new ].
  138.     plotRect origin: oPoint corner: cPoint.
  139.  
  140.     scaleFactor := (rectangle width)/(plotRect right - plotRect left) min:
  141.                 ((rectangle height)/(plotRect top - plotRect bottom)).!
  142.  
  143. iterations: aNum
  144.         "Sets iterationTimes to aNum."
  145.  
  146.     iterationTimes := aNum.!
  147.  
  148. iterTimes: aNum at: aPoint
  149.         "Iterate aNum times starting at aPoint."
  150.     | x y x0 y0 orig scale myMenuBarRect |
  151.  
  152.     scale := magnification * scaleFactor.
  153.     orig := center - (plotRect origin + (plotRect extent / 2) * scale).
  154.     x0 := aPoint x.
  155.     y0 := aPoint y.
  156.     pen up;
  157.         goto: (orig + (x0@y0*scale)) truncated;
  158.         down.
  159.  
  160.     myMenuBarRect := Scheduler menuBar menuBarRectangle.
  161.     aNum timesRepeat: [
  162.         x := x0 - (0.1*((((3*y0) sin) + y0) sin)).
  163.         y := y0 + (0.1*((((3*x0) sin) + x0) sin)).
  164.         pen
  165.             goto: (orig + (x@y*scale)) truncated.
  166.         x0 := x.
  167.         y0 := y.
  168.         EventRecord mouseDown ifTrue: [
  169.             (myMenuBarRect containsPoint:
  170.                     (EventRecord mousePointGlobal )) ifTrue: [
  171.                 Scheduler inMenuBar.
  172.                 menuItem = 'stop' ifTrue: [ ^self].
  173.             ].
  174.             EventRecord getNextEvent.
  175.         ].
  176.     ].!
  177.  
  178. magnification
  179.         "Returns magnification."
  180.  
  181.     ^magnification / 0.5.!
  182.  
  183. magnification: aNum
  184.         "Sets magnification to aNum."
  185.  
  186.     magnification := aNum * 0.5.!
  187.  
  188. menu
  189.     "Answer the menu for the receiver."
  190.  
  191.     menu := (Menu
  192.         labels: 'Restart\Fillin\Stop'
  193.                     breakLinesAtBackSlashes
  194.         selectors: #(restart fillin stop))
  195.             title: 'Fractals'.
  196.     menu disable: #stop.
  197.     ^menu!
  198.  
  199. open
  200.     "Open a window to run the demo"
  201.     | aTopPane |
  202.  
  203.     aTopPane := TopPane new.
  204.     aTopPane
  205.         label: 'Fractal Workspace';
  206.         model: self;
  207.         minimumSize: 300 @ 200;
  208.         windowType: Window rDocProc;
  209.         addSubpane:
  210.             (DrawPane new
  211.                 name: #form:;
  212.                 menu: #menu;
  213.                 change: #click:;
  214.                 model: self;
  215.                 framingBlock: [ :box | box ]).
  216.     aTopPane menuBar addMenu: (TextPane doitMenu owner: aTopPane dispatcher)
  217.                  at: 'Smalltalk'.
  218.     aTopPane whiteOnRedraw: true.
  219.     (aTopPane dispatcher
  220.         openIn: ((Screen boundingBox
  221.                     insetBy: (40 @ 40)) moveBy: (0 @ 10)))
  222.        scheduleWindow!
  223.  
  224. reframe: aRectangle
  225.     "The window has been reframed."
  226.  
  227.     rectangle := aRectangle.
  228.     center := rectangle center.
  229.     pen := Pen new initPen: Display;
  230.         clipRect: aRectangle.
  231.  
  232.     self resolution: 10.
  233.     self from: -20@20 to: 20@-20.
  234.     self magnification: 1.
  235.     self iterations: 50.!
  236.  
  237. resolution: aNum
  238.         "Sets resolution to aNum."
  239.  
  240.     resolution := aNum.!
  241.  
  242. restart
  243.     "Start drawing."
  244.  
  245.     menuItem := 'restart'.
  246.     self cyclicSys.! !
  247.  
  248. (
  249. Object subclass: #Point
  250.   instanceVariableNames:
  251.     'x y '
  252.   classVariableNames: ''
  253.   poolDictionaries: '') comment: '' !
  254.  
  255. !Point methods !
  256.  
  257. / scale
  258.     "Answer a new Point which is the receiver Point divided
  259.      by scale. Scale can be a number or a Point. If scale
  260.      is a Point, the x-coordinates are divided and the y-
  261.      coordinates are divided."
  262.  
  263.     scale class == Point
  264.         ifTrue: [^ ( x / scale x) @ ( y / scale y)]
  265.         ifFalse: [^ ( x / scale) @ ( y / scale)]! !
  266.  
  267.  
  268. Object subclass: #DispatchManager
  269.   instanceVariableNames:
  270.     'dispatchers menuBar activeWindow activeDispatcher clickWindow '
  271.   classVariableNames:
  272.     'TransientWrite None '
  273.   poolDictionaries:
  274.     'SystemMenus CharacterConstants ' !
  275.  
  276. !DispatchManager methods !
  277.  
  278. menuBar
  279.         "return the current menuBar."
  280.  
  281.     ^ menuBar! !
  282.  
  283.  
  284. MType subclass: #EventRecord
  285.   instanceVariableNames: ''
  286.   classVariableNames:
  287.     'CheckEvent TheEvent '
  288.   poolDictionaries: '' !
  289.  
  290. !EventRecord class methods !
  291.  
  292. mousePointGlobal
  293.     "Answer the current GrafPort global position of the
  294.      mouse."
  295.     | p |
  296.  
  297.     p := MRecord new: 4.
  298.     MTrap GetMouse: p asParameter.
  299.     MTrap LocalToGlobal: p asParameter.
  300.     ^ p asPoint! !
  301.